{-# LANGUAGE GADTs #-}

module App.Fossa.Analyze.UploadSpec (spec) where

import App.Fossa.Analyze.Upload (ScanUnits (..), mergeSourceAndLicenseUnits, uploadSuccessfulAnalysis)
import App.Fossa.Config.Analyze (JsonOutput (JsonOutput))
import App.Types (FileUpload (..), LocatorType (..))
import Control.Algebra (Has)
import Control.Carrier.Git (GitC)
import Control.Carrier.Simple (interpret)
import Control.Effect.Diagnostics (fatalText)
import Control.Effect.FossaApiClient (FossaApiClientF (..), PackageRevision (..))
import Control.Effect.Git (GitF (FetchGitContributors))
import Data.Flag (toFlag)
import Data.List.NonEmpty qualified as NE
import Fossa.API.Types (Organization (..), Project (..), UploadResponse (..))
import Srclib.Types (FullSourceUnit (..), LicenseUnitInfo (..), Locator, emptyLicenseUnitData)
import Test.Effect (expectFatal', it', shouldBe')
import Test.Fixtures qualified as Fixtures
import Test.Hspec (Spec, describe)
import Test.Hspec.Core.Spec (runIO)
import Test.MockApi (
  MockApi,
  alwaysReturns,
  fails,
  returnsOnce,
  returnsOnceForAnyRequest,
 )
import Types (GraphBreadth (Complete))

withGit :: (forall x. GitF x -> m x) -> GitC m a -> m a
withGit = interpret

mockGit :: Applicative m => GitF a -> m a
mockGit (FetchGitContributors{}) = pure Fixtures.contributors

expectedLocator :: Locator
expectedLocator = uploadLocator Fixtures.uploadResponse

expectGetSuccess :: Has MockApi sig m => m ()
expectGetSuccess = do
  GetProject Fixtures.projectRevision LocatorTypeCustom `alwaysReturns` Fixtures.project
  GetOrganization `alwaysReturns` Fixtures.organization
  GetApiOpts `alwaysReturns` Fixtures.apiOpts

expectGetProject :: Has MockApi sig m => m ()
expectGetProject = GetProject Fixtures.projectRevision LocatorTypeCustom `alwaysReturns` Fixtures.project

expectGetOrganizationWithFullFileUploads :: Has MockApi sig m => m ()
expectGetOrganizationWithFullFileUploads =
  GetOrganization `alwaysReturns` Fixtures.organization{orgRequiresFullFileUploads = True}

expectGetApiOpts :: Has MockApi sig m => m ()
expectGetApiOpts = GetApiOpts `alwaysReturns` Fixtures.apiOpts

expectAnalysisUploadSuccess :: Has MockApi sig m => m ()
expectAnalysisUploadSuccess = UploadAnalysis Fixtures.projectRevision Fixtures.projectMetadata Fixtures.sourceUnits Nothing `alwaysReturns` Fixtures.uploadResponse

expectContributorUploadSuccess :: Has MockApi sig m => m ()
expectContributorUploadSuccess =
  UploadContributors expectedLocator Fixtures.contributors `alwaysReturns` ()

expectFirstPartyAnalysisUploadSuccess :: FileUpload -> Has MockApi sig m => m ()
expectFirstPartyAnalysisUploadSuccess uploadKind = do
  UploadAnalysisWithFirstPartyLicenses Fixtures.projectRevision Fixtures.projectMetadata uploadKind Nothing `alwaysReturns` Fixtures.uploadResponse

expectGetFirstPartySignedUrl :: Has MockApi sig m => PackageRevision -> m ()
expectGetFirstPartySignedUrl packageRevision = GetSignedFirstPartyScanUrl packageRevision `alwaysReturns` Fixtures.signedUrl

expectUploadFirstPartyDataToS3 :: Has MockApi sig m => m ()
expectUploadFirstPartyDataToS3 = do
  let mergedUnits = mergeSourceAndLicenseUnits Fixtures.sourceUnits Fixtures.firstLicenseSourceUnit
  UploadFirstPartyScanResult Fixtures.signedUrl mergedUnits `returnsOnceForAnyRequest` ()

expectedMergedFullSourceUnits :: NE.NonEmpty FullSourceUnit
expectedMergedFullSourceUnits = NE.fromList [fullSourceUnit, fullLicenseUnit]
  where
    fullSourceUnit =
      FullSourceUnit
        { fullSourceUnitName = "testSourceUnitName"
        , fullSourceUnitType = "testSourceUnitType"
        , fullSourceUnitTitle = Nothing
        , fullSourceUnitManifest = Just "testSourceUnitManifest"
        , fullSourceUnitBuild = Nothing
        , fullSourceUnitGraphBreadth = Complete
        , fullSourceUnitOriginPaths = []
        , fullSourceUnitAdditionalData = Nothing
        , fullSourceUnitFiles = Nothing
        , fullSourceUnitData = Nothing
        , fullSourceUnitInfo = Nothing
        , fullSourceUnitNoticeFiles = []
        }
    fullLicenseUnit =
      FullSourceUnit
        { fullSourceUnitName = "empty"
        , fullSourceUnitType = "LicenseUnit"
        , fullSourceUnitTitle = Nothing
        , fullSourceUnitManifest = Nothing
        , fullSourceUnitBuild = Nothing
        , fullSourceUnitGraphBreadth = Complete
        , fullSourceUnitOriginPaths = []
        , fullSourceUnitAdditionalData = Nothing
        , fullSourceUnitFiles = Just $ "" NE.:| []
        , fullSourceUnitData = Just $ emptyLicenseUnitData NE.:| []
        , fullSourceUnitInfo = Just LicenseUnitInfo{licenseUnitInfoDescription = Nothing}
        , fullSourceUnitNoticeFiles = []
        }

expectGetSuccessWithReachability :: Has MockApi sig m => m ()
expectGetSuccessWithReachability = do
  GetProject Fixtures.projectRevision LocatorTypeCustom `alwaysReturns` Fixtures.project
  GetOrganization `alwaysReturns` Fixtures.organization{orgSupportsReachability = True}
  GetApiOpts `alwaysReturns` Fixtures.apiOpts

expectReachabilityBuildUpload :: (Has MockApi sig m) => m ()
expectReachabilityBuildUpload =
  UploadBuildForReachability
    Fixtures.projectRevision
    Fixtures.projectMetadata
    mempty
    `returnsOnce` ()

uploadSuccessfulAnalysisSpec :: Spec
uploadSuccessfulAnalysisSpec = do
  describe
    "uploadSuccessfulAnalysis"
    $ do
      baseDir <- runIO Fixtures.baseDir
      it' "uploads analysis and git contributors"
        . withGit mockGit
        $ do
          expectGetSuccess
          expectAnalysisUploadSuccess
          expectContributorUploadSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator
      -- Currently our StdOut logging just writes directly to StdOut, so this is
      -- just checking it doesn't fail.  In the future we should extract that so
      -- we can test it better.
      it' "renders JSON output when requested"
        . withGit mockGit
        $ do
          expectAnalysisUploadSuccess
          expectContributorUploadSuccess
          expectGetSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) True)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator
      it' "performs reachability upload, if organization supports reachability"
        . withGit mockGit
        $ do
          expectGetSuccessWithReachability
          expectAnalysisUploadSuccess
          expectContributorUploadSuccess
          expectReachabilityBuildUpload
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator

      it' "aborts when uploading to a monorepo"
        . expectFatal'
        . withGit mockGit
        $ do
          GetProject Fixtures.projectRevision LocatorTypeCustom `returnsOnce` Fixtures.project{projectIsMonorepo = True}
          uploadSuccessfulAnalysis
            baseDir
            Fixtures.projectMetadata
            (toFlag (JsonOutput) False)
            Fixtures.projectRevision
            (SourceUnitOnly Fixtures.sourceUnits)
            mempty
            Nothing
      it' "continues if fetching the project fails"
        . withGit mockGit
        $ do
          GetProject Fixtures.projectRevision LocatorTypeCustom `fails` "Mocked failure fetching project"
          expectAnalysisUploadSuccess
          expectContributorUploadSuccess
          GetOrganization `alwaysReturns` Fixtures.organization
          GetApiOpts `alwaysReturns` Fixtures.apiOpts

          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator
      it' "continues if fetching contributors fails"
        . withGit (\_ -> fatalText "Mocked failure of fetching contributors from git")
        $ do
          expectGetSuccess
          expectAnalysisUploadSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator
      it' "continues if uploading contributors fails"
        . withGit mockGit
        $ do
          UploadContributors expectedLocator Fixtures.contributors `fails` "Mocked failure uploading contributors"
          expectAnalysisUploadSuccess
          expectGetSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceUnitOnly Fixtures.sourceUnits)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator
      it' "uploads to S3 and to /api/builds/custom_with_first_party_licenses if there are licenses"
        . withGit mockGit
        $ do
          expectGetSuccess
          expectGetFirstPartySignedUrl PackageRevision{packageName = "testProjectName", packageVersion = "testRevision"}
          expectUploadFirstPartyDataToS3
          expectFirstPartyAnalysisUploadSuccess FileUploadMatchData
          expectContributorUploadSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceAndLicenseUnits Fixtures.sourceUnits Fixtures.firstLicenseSourceUnit)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator

      it' "uploads to S3 and to /api/builds/custom_with_first_party_licenses if there are licenses and no targets were found"
        . withGit mockGit
        $ do
          expectGetSuccess
          expectGetFirstPartySignedUrl PackageRevision{packageName = "testProjectName", packageVersion = "testRevision"}
          expectUploadFirstPartyDataToS3
          expectFirstPartyAnalysisUploadSuccess FileUploadMatchData
          expectContributorUploadSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (LicenseSourceUnitOnly Fixtures.firstLicenseSourceUnit)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator

      it' "uploads to S3 and to /api/builds/custom_with_first_party_licenses if there are licenses and full file uploads is set on the org"
        . withGit mockGit
        $ do
          expectGetProject
          expectGetOrganizationWithFullFileUploads
          expectGetApiOpts
          expectGetFirstPartySignedUrl PackageRevision{packageName = "testProjectName", packageVersion = "testRevision"}
          expectUploadFirstPartyDataToS3
          expectFirstPartyAnalysisUploadSuccess FileUploadFullContent
          expectContributorUploadSuccess
          locator <-
            uploadSuccessfulAnalysis
              baseDir
              Fixtures.projectMetadata
              (toFlag (JsonOutput) False)
              Fixtures.projectRevision
              (SourceAndLicenseUnits Fixtures.sourceUnits Fixtures.firstLicenseSourceUnit)
              mempty
              Nothing
          locator `shouldBe'` expectedLocator

mergeSourceAndLicenseUnitsSpec :: Spec
mergeSourceAndLicenseUnitsSpec =
  describe
    "mergeSourceAndLicenseUnits"
    $ do
      it' "merges source and license units" $ do
        let mergedUnits = mergeSourceAndLicenseUnits Fixtures.sourceUnits Fixtures.firstLicenseSourceUnit
        mergedUnits `shouldBe'` expectedMergedFullSourceUnits

spec :: Spec
spec = do
  uploadSuccessfulAnalysisSpec

  mergeSourceAndLicenseUnitsSpec
